﻿Imports System.Text

Public Class JSONStringer
    ''' <summary>
    ''' 输出数据，最多包含一个顶级数组或对象。
    ''' </summary>
    ''' <remarks></remarks>
    Friend out As StringBuilder = New StringBuilder()

    ''' <summary>左方括号</summary>
    Private Const BRACKETS_CURLY_LEFT = "{"
    ''' <summary>右方括号</summary>
    Private Const BRACKETS_CURLY_RIGHT = "}"
    ''' <summary>左方括号</summary>
    Private Const BRACKETS_SQUARE_LEFT = "["
    ''' <summary>右方括号</summary>
    Private Const BRACKETS_SQUARE_RIGHT = "]"
    ''' <summary>双引号</summary>
    Private Const DOUNLE_QUOTATION_MARK = """"
    ''' <summary>逗号</summary>
    Private Const COMMA = ","
    ''' <summary>冒号</summary>
    Private Const COLON = ":"
    ''' <summary>冒号和空格</summary>
    Private Const COLON_AND_SPACE = ": "
    ''' <summary>空格</summary>
    Private Const SPACE = " "
    ''' <summary>
    ''' 范围
    ''' </summary>
    ''' <remarks></remarks>
    Enum Scope
        ''' <summary>没有元素的数组在关闭之前不需要分隔符或换行符。</summary>
        EMPTY_ARRAY = 0
        ''' <summary>至少有一个值的数组需要在下一个元素前加逗号和换行符。</summary>
        NONEMPTY_ARRAY = 1
        ''' <summary>没有键或值的对象在关闭前不需要分隔符或换行符。</summary>
        EMPTY_OBJECT = 2
        ''' <summary>其最新元素是键的对象。下一个元素必须是值。</summary>
        DANGLING_KEY = 3
        ''' <summary>至少有一个名称/值对的对象在下一个元素之前需要逗号和换行符。</summary>
        NONEMPTY_OBJECT = 4
        ''' <summary>一种特殊的无支架数组JSONStringer.join连接（）和JSONObject.quote文件（）仅限。不用于JSON编码。</summary>
        NULL = 5
    End Enum
    ''' <summary>
    ''' 与最初的实现不同，这个堆栈不限于20层嵌套。
    ''' </summary>
    ''' <remarks></remarks>
    Dim stack As List(Of Scope) = New List(Of Scope)
    ''' <summary>
    ''' 一个字符串，包含一个完整的空格集，用于一个缩进级别，如果没有漂亮的打印，则为nothing。
    ''' </summary>
    ''' <remarks></remarks>
    Dim indent As String
    Public Sub New()
        indent = Nothing
    End Sub
    Public Sub New(ByVal indentSpaces As Integer)
        Dim indentChars(indentSpaces) As Char
        For i = 0 To indentChars.Count - 1
            indentChars(i) = SPACE
        Next
        indent = New String(indentChars)
    End Sub
    ''' <summary>
    ''' 开始编码新数组。对该方法的每个调用必须与对<code>endArray</code>的调用配对。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function startArray() As JSONStringer
        Return open(Scope.EMPTY_ARRAY, BRACKETS_SQUARE_LEFT)
    End Function
    ''' <summary>
    ''' 结束对当前数组的编码。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function endArray() As JSONStringer
        Return close(Scope.EMPTY_ARRAY, Scope.NONEMPTY_ARRAY, BRACKETS_SQUARE_RIGHT)
    End Function
    ''' <summary>
    ''' 开始编码新对象。对该方法的每个调用必须与对<code>endObject</code>的调用配对。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function startObject() As JSONStringer
        Return open(Scope.EMPTY_OBJECT, BRACKETS_CURLY_LEFT)
    End Function
    ''' <summary>
    ''' 结束对当前对象的编码。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function endObject() As JSONStringer
        Return close(Scope.EMPTY_OBJECT, Scope.NONEMPTY_OBJECT, BRACKETS_CURLY_RIGHT) '"}")
    End Function
    ''' <summary>
    ''' 编码<code>val</code>。
    ''' </summary>
    ''' <param name="val">
    ''' <code>JSONObject</code>、<code>JSONArray</code>、String、Boolean、Integer、Long、Double或null。。
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function value(ByVal val As Object) As JSONStringer
        If stack.Count = 0 Then
            Throw New Exception("嵌套问题")
        End If
        If val.GetType.Equals(GetType(JSONArray)) Then
            Dim arrayVal As JSONArray = val
            arrayVal.writeTo(Me)
            Return Me
        ElseIf val.GetType.Equals(GetType(JSONObject)) Then
            Dim objVal As JSONObject = val
            objVal.writeTo(Me)
            Return Me
        ElseIf val.GetType.Equals(GetType(Dictionary(Of String, Object))) Or val.GetType.Equals(GetType(SortedDictionary(Of String, Object))) Or _
            val.GetType.Equals(GetType(SortedList(Of String, Object))) Or val.GetType.Equals(GetType(Hashtable)) Then
            Dim jsObject As JSONObject = New JSONObject(val)
            jsObject.writeTo(Me)
            Return Me
        ElseIf IsArray(val) Or val.GetType.Equals(GetType(IList(Of Object))) Or val.GetType.Equals(GetType(List(Of Object))) Or _
            val.GetType.Equals(GetType(HashSet(Of Object))) Or val.GetType.Equals(GetType(SortedSet(Of Object))) Or _
            val.GetType.Equals(GetType(ArrayList)) Then
            Dim jsArray As JSONArray = New JSONArray(val)
            jsArray.writeTo(Me)
            Return Me
        End If
        beforeValue()
        If IsNothing(val) Or (val.GetType.Equals(GetType(Boolean))) Then
            out.Append(val.ToString.ToLower)  '将布尔数据转为小写字符串
        ElseIf Numeric(val.GetType) Then
            out.Append(JSONObject.numberToString(val))
        Else
            setString(val.ToString())
        End If
        Return Me
    End Function
    Public Function value(ByVal val As Boolean) As JSONStringer
        If stack.Count = 0 Then
            Throw New Exception("嵌套问题")
        End If
        beforeValue()
        out.Append(val.ToString.ToLower)  '将布尔数据转为小写字符串
        Return Me
    End Function
    Public Function value(ByVal val As Double) As JSONStringer
        If stack.Count = 0 Then
            Throw New Exception("嵌套问题")
        End If
        beforeValue()
        out.Append(val)
        Return Me
    End Function
    Public Function value(ByVal val As Long) As JSONStringer
        If stack.Count = 0 Then
            Throw New Exception("嵌套问题")
        End If
        beforeValue()
        out.Append(val)
        Return Me
    End Function
    Public Function value(ByVal val As Integer) As JSONStringer
        If stack.Count = 0 Then
            Throw New Exception("嵌套问题")
        End If
        beforeValue()
        out.Append(val)
        Return Me
    End Function
    Public Function value(ByVal val As UInteger) As JSONStringer
        If stack.Count = 0 Then
            Throw New Exception("嵌套问题")
        End If
        beforeValue()
        out.Append(val)
        Return Me
    End Function
    Public Function value(ByVal val As Short) As JSONStringer
        If stack.Count = 0 Then
            Throw New Exception("嵌套问题")
        End If
        beforeValue()
        out.Append(val)
        Return Me
    End Function
    Public Function value(ByVal val As UShort) As JSONStringer
        If stack.Count = 0 Then
            Throw New Exception("嵌套问题")
        End If
        beforeValue()
        out.Append(val)
        Return Me
    End Function
    ''' <summary>
    ''' 对该字符串的键（属性名）进行编码。
    ''' </summary>
    ''' <param name="name">即将出现的值的名称。不能为空。</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function key(ByVal name As String) As JSONStringer
        If String.IsNullOrEmpty(name) Then
            Throw New Exception("名称必须为非空或长度不能为0")
        End If
        beforeKey()
        setString(name)
        Return Me
    End Function
    ''' <summary>
    ''' 返回编码的JSON字符串。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Overloads Function toString() As String
        If out.Length = 0 Then
            Return Nothing
        Else
            Return out.ToString()
        End If
    End Function
    ''' <summary>
    ''' 通过附加任何必要的空格和给定的括号来输入新的范围。
    ''' </summary>
    ''' <param name="empty"></param>
    ''' <param name="openBracket">用于开始的符号,只能是:{或[</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Friend Function open(ByVal empty As Scope, ByVal openBracket As String) As JSONStringer
        If stack.Count = 0 And out.Length > 0 Then
            Throw New Exception("嵌套问题：多个顶级根")
        End If
        beforeValue()
        stack.Add(empty)
        out.Append(openBracket)
        Return Me
    End Function
    ''' <summary>
    ''' 通过附加任何必要的空白和给定的括号来关闭当前范围。
    ''' </summary>
    ''' <param name="empty"></param>
    ''' <param name="nonempty"></param>
    ''' <param name="closeBracket">用于关闭的符号，必须与<code>open</code>时使用的符号时一对并且只能是:}或]</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Friend Function close(ByVal empty As Scope, ByVal nonempty As Scope, ByVal closeBracket As String) As JSONStringer
        Dim context As Scope = peek()
        If (context <> nonempty) And (context <> empty) Then
            Throw New Exception("嵌套问题")
        End If
        ' stack.Remove(stack.Count - 1)
        stack.RemoveAt(stack.Count - 1)
        If context = empty Then
            newline()
        End If
        out.Append(closeBracket)
        Return Me
    End Function
    ''' <summary>
    ''' 在名称前插入任何必要的分隔符和空格。还调整堆栈以期望键的值。
    ''' </summary>
    ''' <remarks></remarks>
    Friend Sub beforeKey()
        Dim context As Scope = peek()
        If context = Scope.NONEMPTY_OBJECT Then
            out.Append(COMMA)   '添加逗号
        ElseIf context <> Scope.EMPTY_OBJECT Then
            Throw New Exception("嵌套问题")
        End If
        newline()
        replaceTop(Scope.DANGLING_KEY)
    End Sub
    ''' <summary>
    ''' 在文字值、行数组或内联对象之前插入任何必要的分隔符和空格。同时调整堆栈以期望右括号或其他元素。
    ''' </summary>
    ''' <remarks></remarks>
    Friend Sub beforeValue()
        If stack.Count = 0 Then
            Return
        End If
        Dim context As Scope = peek()
        If context = Scope.EMPTY_ARRAY Then '数组中的第一
            replaceTop(Scope.NONEMPTY_ARRAY)
            newline()
        ElseIf context = Scope.NONEMPTY_ARRAY Then '数组中的另一个
            out.Append(COMMA) '添加逗号
            newline()
        ElseIf context = Scope.DANGLING_KEY Then  '键的值
            out.Append(IIf(IsNothing(indent), COLON, COLON_AND_SPACE))
            replaceTop(Scope.NONEMPTY_OBJECT)
        ElseIf context <> Scope.NULL Then
            Throw New Exception("嵌套问题")
        End If
    End Sub
    ''' <summary>
    ''' 返回堆栈顶部的值。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Friend Function peek() As Scope
        If IsNothing(stack) Then
            Throw New Exception("嵌套问题")
        ElseIf stack.Count = 0 Then
            Throw New Exception("嵌套问题")
        End If
        Return stack.Item(stack.Count - 1)
    End Function
    ''' <summary>
    ''' 用给定值替换堆栈顶部的值。
    ''' </summary>
    ''' <param name="topOfStack"></param>
    ''' <remarks></remarks>
    Friend Sub replaceTop(ByVal topOfStack As Scope)
        stack.Item(stack.Count - 1) = topOfStack
    End Sub
    Friend Sub newline()
        If IsNothing(indent) Then
            Return
        End If
        out.Append(vbLf)   '附加换行符
        For i = 0 To stack.Count - 1
            out.Append(indent)
        Next
    End Sub
    Friend Sub setString(ByVal val As String)
        out.Append(DOUNLE_QUOTATION_MARK)
        For i As Integer = 0 To val.Length - 1
            Dim c As Char = val.Chars(i)
            Select Case c
                Case DOUNLE_QUOTATION_MARK, "\", "/"  ''\\'
                    out.Append("\").Append(c)
                Case vbTab  ' '\t'
                    out.Append("\t")
                Case vbBack   ''\b'
                    out.Append("\b")
                Case vbLf   ''\n'
                    out.Append("\n")
                Case vbCr   ''\r'
                    out.Append("\r")
                Case vbFormFeed ''\f'
                    out.Append("\f")
                Case Else
                    If Asc(c) <= &H1F Then
                        out.Append(String.Format("\u%04x", Asc(c)))
                    Else
                        out.Append(c)
                    End If
            End Select
        Next
        out.Append(DOUNLE_QUOTATION_MARK)
    End Sub

    ''' <summary>
    ''' 类型是数字类型
    ''' </summary>
    ''' <param name="dataType">类型</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function Numeric(ByVal dataType As Type) As Boolean
        If Microsoft.VisualBasic.IsNothing(dataType) Then
            Return False
        Else
            Return dataType.Equals(GetType(Byte)) Or dataType.Equals(GetType(SByte)) Or dataType.Equals(GetType(Char)) Or _
                   dataType.Equals(GetType(Short)) Or dataType.Equals(GetType(UShort)) Or dataType.Equals(GetType(Integer)) Or _
                   dataType.Equals(GetType(UInteger)) Or dataType.Equals(GetType(Long)) Or dataType.Equals(GetType(ULong)) Or _
                   dataType.Equals(GetType(Single)) Or dataType.Equals(GetType(Double)) Or dataType.Equals(GetType(Int16)) Or _
                   dataType.Equals(GetType(Int32)) Or dataType.Equals(GetType(Int64)) Or dataType.Equals(GetType(UInt16)) Or _
                   dataType.Equals(GetType(UInt32)) Or dataType.Equals(GetType(UInt64)) Or dataType.Equals(GetType(UIntPtr))
        End If
    End Function
End Class
